home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / qwik40.arc / QINITEST.PAS < prev    next >
Pascal/Delphi Source File  |  1991-01-09  |  5KB  |  162 lines
  1. { Qinitest.pas - tests your system configuration            ver 4.0, 12-01-87 }
  2.  
  3. program Qinitest;
  4.  
  5. uses
  6.   Crt, {$U Qwik40.tpu} Qwik;
  7.  
  8. type
  9.   Str9 = string[9];
  10.  
  11. var
  12.   CursorMode: integer absolute $0040:$0060;
  13.   b,OldVideoMode: byte;
  14.   Strng:          string;
  15.   ch:             char;
  16.  
  17. function DecToHex (Number: longint; Nibbles: byte): str9;
  18. const
  19.   D2H: array[0..$0F] of char = ('0','1','2','3','4','5','6','7',
  20.                                 '8','9','A','B','C','D','E','F');
  21. var
  22.   BuildStr:  Str9;
  23.   Mask:      longint;
  24.   Nibs,Bits: byte;
  25. begin
  26.   BuildStr:='$';
  27.   Mask:=$F;
  28.   for Nibs:=pred(Nibbles) downto 0 do
  29.     begin
  30.       Bits:=Nibs shl 2;
  31.       BuildStr:=BuildStr + D2H[(Number and (Mask shl Bits)) shr Bits];
  32.     end;
  33.   DecToHex:=BuildStr;
  34. end;
  35.  
  36. procedure DisplayDev (DD: byte);
  37. begin
  38.   case DD of
  39.     $00: Strng:='No display';
  40.     $01: Strng:='MDA with 5151 monochrome';
  41.     $02: Strng:='CGA with 5153/4 color';
  42.     $04: Strng:='EGA with 5153/4 color';
  43.     $05: Strng:='EGA with 5151 monochrome';
  44.     $06: Strng:='PGC with 5175 color';
  45.     $07: Strng:='VGA with analog monochrome';
  46.     $08: Strng:='VGA with analog color';
  47.     $0B: Strng:='MCGA with analog monochrome';
  48.     $0C: Strng:='MCGA with analog color';
  49.   else Strng:='Reserved';
  50.   end; { case }
  51. end;
  52.  
  53. begin
  54.   OldVideoMode:=VideoMode;
  55.   NormVideo;
  56.   Qfill (1,1,25,CRTcols,TextAttr,' ');
  57.   Qwrite (1,1,-1,'Which text mode [0,1,2,3,7] ? ');
  58.   GotoRC (1,31);
  59.   repeat
  60.     Ch:=readkey;
  61.   until Ch in ['0'..'3','7'];
  62.   b:=ord(Ch)-ord('0');
  63.   if b<>OldVideoMode then
  64.     begin
  65.       TextMode(b);
  66.       Qinit;
  67.     end;
  68.   CheckSnow:=Qsnow;
  69.   Qfill (1,1,25,CRTcols,TextAttr,' ');
  70.   GotoRC (1,1);
  71.   case SystemID of
  72.     $FF: Strng:='IBM PC';
  73.     $FE: Strng:='IBM PC XT';
  74.     $FD: Strng:='IBM PCjr';
  75.     $FC: case SubModelID of
  76.            $00: Strng:='IBM PC AT (6 MHz)';
  77.            $01: Strng:='IBM PC AT (8 MHz)';
  78.            $02: Strng:='IBM PC XT (286)';
  79.            $04: Strng:='IBM PS/2 Model 50';
  80.            $05: Strng:='IBM PS/2 Model 60';
  81.          else   Strng:='IBM PS/2 VGA type';
  82.          end;
  83.     $FB: Strng:='IBM PC XT (256/640)';
  84.     $FA: case SubModelID of
  85.            $00: Strng:='IBM PS/2 Model 30';
  86.            $01: Strng:='IBM PS/2 Model 25';
  87.          else   Strng:='IBM PS/2 MCGA type';
  88.          end;
  89.     $F9: Strng:='IBM PC convertible';
  90.     $F8: case SubModelID of
  91.            $00: Strng:='IBM PS/2 Model 80 (16 MHz)';
  92.            $01: Strng:='IBM PS/2 Model 80 (20 MHz)';
  93.          else   Strng:='IBM PS/2 Model 70/80 type';
  94.          end;
  95.   end;  { case }
  96.   writeln ('System ID         = ',DecToHex(SystemID,2));
  97.   writeln ('SubModel ID       = ',SubModelID);
  98.   writeln ('  ',Strng);
  99.   writeln ('PS/2 equipment    = ',HavePS2);
  100.   writeln ('IBM 3270 PC       = ',Have3270);
  101.   writeln ('Prior video mode  = ',OldVideoMode);
  102.   writeln ('Video mode now    = ',VideoMode);
  103.   writeln ('Wait-for-retrace  = ',Qsnow);
  104.   writeln ('Max page #        = ',MaxPage);
  105.  
  106.   if Have3270 then
  107.     begin
  108.       writeln ('Disp Dev 3270     = ',DecToHex(ActiveDispDev3270,2));
  109.       case ActiveDispDev3270 of
  110.         $00: Strng:='5151 or 5272 display and adapter';
  111.         $01: Strng:='3295 display and adapter';
  112.         $02: Strng:='5151 or 5272, adapter, XGA graphics';
  113.         $03: Strng:='5279 display, 3270 PC G adapter';
  114.         $04: Strng:='5379 C01 display, 3270 PC GX adapter';
  115.         $05: Strng:='5379 M01 display, 3270 PC GX adapter';
  116.         $FF: Strng:='Unknown, not a 3270 PC';
  117.       else Strng:='Reserved';
  118.       end;
  119.       writeln ('  ',Strng);
  120.     end
  121.   else
  122.     begin
  123.       DisplayDev (ActiveDispDev);
  124.       writeln ('Active Disp Dev   = ',DecToHex(ActiveDispDev,2));
  125.       writeln ('  ',Strng);
  126.  
  127.       if SystemID=$F9 then
  128.         writeln ('Alt Disp Dev PC Conv = ',DecToHex(AltDispDevPCC,4))
  129.       else
  130.         begin
  131.           DisplayDev (AltDispDev);
  132.           writeln ('Alt Disp Dev      = ',DecToHex(AltDispDev,2));
  133.           writeln ('  ',Strng);
  134.         end;
  135.  
  136.       writeln ('Hercules model    = ',HercModel);
  137.       case HercModel of
  138.         0: Strng:='No Hercules card';
  139.         1: Strng:='Hercules Graphics Card';
  140.         2: Strng:='Hercules Graphics Card Plus';
  141.         3: Strng:='Hercules InColor Card';
  142.       end;
  143.       writeln ('  ',Strng);
  144.     end;
  145.  
  146.   writeln ('Cursor start      = ',DecToHex(hi(CursorMode),2));
  147.   writeln ('Cursor end        = ',DecToHex(lo(CursorMode),2));
  148.   writeln ('CRT rows          = ',CRTrows);
  149.   writeln ('CRT columns       = ',CRTcols);
  150.   if (ActiveDispDev>=EgaColor) and (ActiveDispDev<=McgaColor) then
  151.     begin
  152.       writeln ('EGA rows          = ',EgaRows);
  153.       writeln ('EGA FontSize      = ',EgaFontSize);
  154.       writeln ('EGA Info          = ',DecToHex(EgaInfo,2));
  155.       writeln ('EGA Switches      = ',DecToHex(EgaSwitches,2));
  156.     end;
  157.   writeln;
  158.   write ('Press any key...');
  159.   Ch:=ReadKey;
  160.   TextMode (OldVideoMode);
  161. end.
  162.